home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / interp / load.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  27.0 KB  |  1,202 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: load.c,v 1.27 94/11/29 06:43:04 wlott Exp $
  27. *
  28. * This file implements the loader.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33. #include "../compat/std-os.h"
  34.  
  35. #include <ctype.h>
  36.  
  37. #include "mindy.h"
  38. #include "bool.h"
  39. #include "list.h"
  40. #include "module.h"
  41. #include "str.h"
  42. #include "sym.h"
  43. #include "num.h"
  44. #include "thread.h"
  45. #include "interp.h"
  46. #include "func.h"
  47. #include "obj.h"
  48. #include "gc.h"
  49. #include "class.h"
  50. #include "char.h"
  51. #include "driver.h"
  52. #include "debug.h"
  53. #include "instance.h"
  54. #include "vec.h"
  55. #include "error.h"
  56. #include "../comp/fileops.h"
  57. #include "load.h"
  58.  
  59. #if BUFSIZ > 4096
  60. #define BUFFER_SIZE BUFSIZ
  61. #else
  62. #define BUFFER_SIZE 4096
  63. #endif
  64.  
  65. #ifndef DEFAULT_LOAD_PATH
  66. #define DEFAULT_LOAD_PATH LIBDIR
  67. #endif
  68.  
  69. struct form {
  70.     obj_t method;
  71.     struct form *next;
  72. };
  73.  
  74. struct queue {
  75.     struct form *head;
  76.     struct form **tail;
  77. };
  78.  
  79. struct load_state {
  80.     struct queue everything;
  81.     struct queue classes;
  82.     struct queue top_level_forms;
  83. };
  84.  
  85. static struct load_state State;
  86.  
  87. struct load_info {
  88.     char *name;
  89.     int fd;
  90.     unsigned char *buffer, *ptr, *end;
  91.     obj_t *table, *table_end;
  92.     int next_handle;
  93.     boolean swap_bytes;
  94.     boolean done;
  95.     struct library *library;
  96.     struct module *module;
  97.     obj_t mtime;
  98.     obj_t source_file;
  99. };
  100.  
  101. static obj_t (*opcodes[256])(struct load_info *info);
  102.  
  103.  
  104. /* Utility routines. */
  105.  
  106. static int safe_read(struct load_info *info, void *ptr, int bytes)
  107. {
  108.     int count = read(info->fd, ptr, bytes);
  109.  
  110.     if (count < 0)
  111.     error("error loading %s: %s",
  112.           make_byte_string(info->name),
  113.           make_byte_string(strerror(errno)));
  114.     if (count == 0)
  115.     error("premature EOF loading %s", make_byte_string(info->name));
  116.  
  117.     return count;
  118. }
  119.  
  120. static void read_bytes(struct load_info *info, void *ptr, int bytes)
  121. {
  122.     int count = info->end - info->ptr;
  123.  
  124.     while (1) {
  125.     if (bytes <= count) {
  126.         memcpy(ptr, info->ptr, bytes);
  127.         info->ptr += bytes;
  128.         return;
  129.     }
  130.  
  131.     memcpy(ptr, info->ptr, count);
  132.     ptr = (char *)ptr + count;
  133.     bytes -= count;
  134.     info->ptr = info->end = info->buffer;
  135.  
  136.     while (bytes > BUFFER_SIZE) {
  137.         count = safe_read(info, ptr, bytes);
  138.         ptr = (char *)ptr + count;
  139.         bytes -= count;
  140.     }
  141.     
  142.     if (bytes == 0)
  143.         return;
  144.     
  145.     count = safe_read(info, info->buffer, BUFFER_SIZE);
  146.     info->end = info->buffer + count;
  147.     }
  148. }
  149.  
  150. static void read_ordered_bytes(struct load_info *info, void *ptr, int bytes)
  151. {
  152.     if (info->swap_bytes) {
  153.     unsigned char *dst = (unsigned char *)ptr + bytes;
  154.     unsigned char *src = info->ptr;
  155.     unsigned char *end = info->end;
  156.  
  157.     while (end-src < dst-(unsigned char *)ptr) {
  158.         while (src < end)
  159.         *--dst = *src++;
  160.         src = info->buffer;
  161.         end = src + safe_read(info, src, BUFFER_SIZE);
  162.     }
  163.     while (dst > (unsigned char *)ptr)
  164.         *--dst = *src++;
  165.     info->ptr = src;
  166.     info->end = end;
  167.     }
  168.     else
  169.     read_bytes(info, ptr, bytes);
  170. }
  171.  
  172. static int read_byte(struct load_info *info)
  173. {
  174.     unsigned char *ptr = info->ptr;
  175.  
  176.     if (ptr == info->end) {
  177.     ptr = info->buffer;
  178.     info->end = ptr + safe_read(info, ptr, BUFFER_SIZE);
  179.     }
  180.     info->ptr = ptr+1;
  181.  
  182.     return *ptr;
  183. }
  184.  
  185. static void unread_byte(struct load_info *info)
  186. {
  187.     if (info->ptr == info->buffer)
  188.     lose("unread_byte used while buffer empty.");
  189.  
  190.     info->ptr--;
  191. }
  192.  
  193. static unsigned short read_ushort(struct load_info *info)
  194. {
  195.     unsigned short res;
  196.  
  197.     read_ordered_bytes(info, &res, sizeof(res));
  198.  
  199.     return res;
  200. }
  201.  
  202. static short read_short(struct load_info *info)
  203. {
  204.     short res;
  205.  
  206.     read_ordered_bytes(info, &res, sizeof(res));
  207.  
  208.     return res;
  209. }
  210.  
  211. static int read_int(struct load_info *info)
  212. {
  213.     int res;
  214.  
  215.     read_ordered_bytes(info, &res, sizeof(res));
  216.  
  217.     return res;
  218. }
  219.  
  220. static long read_long(struct load_info *info)
  221. {
  222.     long res;
  223.  
  224.     read_ordered_bytes(info, &res, sizeof(res));
  225.  
  226.     return res;
  227. }
  228.  
  229. static obj_t read_thing(struct load_info *info)
  230. {
  231.     int byte = read_byte(info);
  232.  
  233.     return (*opcodes[byte])(info);
  234. }
  235.  
  236.  
  237. /* Actual loader operations. */
  238.  
  239. static obj_t fop_flame(struct load_info *info)
  240. {
  241.     lose("Bogus opcode in %s\n", info->name);
  242.     return NULL;
  243. }
  244.  
  245. static void check_size(struct load_info *info, int desired, char *what)
  246. {
  247.     int bytes = read_byte(info);
  248.  
  249.     if (bytes != desired)
  250.     error("Wrong sized %s in %s: should be %d but is %d",
  251.           make_byte_string(what), make_byte_string(info->name),
  252.           make_fixnum(desired), make_fixnum(bytes));
  253. }
  254.  
  255. static obj_t fop_header(struct load_info *info)
  256. {
  257.     short x;
  258.     long magic;
  259.     int major_version, minor_version;
  260.  
  261.     major_version = read_byte(info);
  262.     minor_version = read_byte(info);
  263.  
  264.     if (major_version < file_MajorVersion)
  265.     error("Obsolete .dbc file: %s", make_byte_string(info->name));
  266.     if (major_version > file_MajorVersion | minor_version > file_MinorVersion)
  267.     error("Obsolete version of Mindy for %s",
  268.           make_byte_string(info->name));
  269.  
  270.     check_size(info, sizeof(short), "short");
  271.     check_size(info, sizeof(int), "int");
  272.     check_size(info, sizeof(long), "long");
  273.     check_size(info, sizeof(float), "float");
  274.     check_size(info, sizeof(double), "double");
  275.     check_size(info, sizeof(long double), "long double");
  276.  
  277.     read_bytes(info, &x, sizeof(short));
  278.     info->swap_bytes = (x != 1);
  279.  
  280.     magic = read_int(info);
  281.  
  282.     if (magic != dbc_MagicNumber)
  283.     error("Invalid .dbc file: %s", make_byte_string(info->name));
  284.     
  285.     return obj_False;
  286. }
  287.  
  288. static int next_handle(struct load_info *info)
  289. {
  290.     int res = info->next_handle++;
  291.     return res;
  292. }
  293.  
  294. static obj_t store(struct load_info *info, obj_t value, int handle)
  295. {
  296.     int size = info->table_end - info->table;
  297.  
  298.     if (handle >= size) {
  299.     if (handle < 16*1024) {
  300.         if (size == 0)
  301.         size = 1024;
  302.         while (handle >= size)
  303.         size *= 2;
  304.     }
  305.     else
  306.         size = ((handle + 16*1024-1) / (16*1024)) * 16*1024;
  307.     if (info->table)
  308.         info->table = realloc(info->table, sizeof(obj_t) * size);
  309.     else
  310.         info->table = malloc(sizeof(obj_t) * size);
  311.     info->table_end = info->table + size;
  312.     }
  313.  
  314.     info->table[handle] = value;
  315.  
  316.     return value;
  317. }
  318.  
  319. static obj_t fop_store(struct load_info *info)
  320. {
  321.     int handle = next_handle(info);
  322.     return(store(info, read_thing(info), handle));
  323. }
  324.  
  325. static obj_t ref(struct load_info *info, int index)
  326. {
  327.     int table_size = info->table_end - info->table;
  328.  
  329.     if (index < 0 || index >= table_size)
  330.     lose("Bogus ref index %d, should be >= 0 and < %d\n",
  331.          index, table_size);
  332.  
  333.     return info->table[index];
  334. }
  335.  
  336. static obj_t fop_short_ref(struct load_info *info)
  337. {
  338.     return ref(info, read_ushort(info));
  339. }
  340.  
  341. static obj_t fop_ref(struct load_info *info)
  342. {
  343.     return ref(info, read_int(info));
  344. }
  345.  
  346. static obj_t fop_false(struct load_info *info)
  347. {
  348.     return obj_False;
  349. }
  350.  
  351. static obj_t fop_true(struct load_info *info)
  352. {
  353.     return obj_True;
  354. }
  355.  
  356. static obj_t fop_unbound(struct load_info *info)
  357. {
  358.     return obj_Unbound;
  359. }
  360.  
  361. static obj_t fop_signed_byte(struct load_info *info)
  362. {
  363.     return make_fixnum((signed char)read_byte(info));
  364. }
  365.  
  366. static obj_t fop_signed_short(struct load_info *info)
  367. {
  368.     return make_fixnum(read_short(info));
  369. }
  370.  
  371. static obj_t fop_signed_int(struct load_info *info)
  372. {
  373.     return make_fixnum(read_int(info));
  374. }
  375.  
  376. static obj_t fop_signed_long(struct load_info *info)
  377. {
  378.     return make_fixnum(read_long(info));
  379. }
  380.  
  381. static obj_t fop_char(struct load_info *info)
  382. {
  383.     return int_char(read_byte(info));
  384. }
  385.  
  386. static obj_t fop_single_float(struct load_info *info)
  387. {
  388.     float f;
  389.  
  390.     read_ordered_bytes(info, &f, 4);
  391.  
  392.     return make_single(f);
  393. }
  394.  
  395. static obj_t fop_double_float(struct load_info *info)
  396. {
  397.     double d;
  398.  
  399.     read_ordered_bytes(info, &d, sizeof(d));
  400.  
  401.     return make_double(d);
  402. }
  403.  
  404. static obj_t fop_extended_float(struct load_info *info)
  405. {
  406.     long double d;
  407.  
  408.     read_ordered_bytes(info, &d, sizeof(d));
  409.  
  410.     return make_extended(d);
  411. }
  412.  
  413. static obj_t fop_short_string(struct load_info *info)
  414. {
  415.     int len = read_byte(info);
  416.     obj_t res = alloc_byte_string(len);
  417.  
  418.     read_bytes(info, string_chars(res), len);
  419.  
  420.     return res;
  421. }
  422.  
  423. static obj_t fop_string(struct load_info *info)
  424. {
  425.     int len = read_int(info);
  426.     obj_t res = alloc_byte_string(len);
  427.  
  428.     read_bytes(info, string_chars(res), len);
  429.  
  430.     return res;
  431. }
  432.  
  433. static obj_t fop_short_symbol(struct load_info *info)
  434. {
  435.     return store(info, symbol((char *)string_chars(fop_short_string(info))),
  436.          next_handle(info));
  437. }
  438.  
  439. static obj_t fop_symbol(struct load_info *info)
  440. {
  441.     return store(info, symbol((char *)string_chars(fop_string(info))),
  442.          next_handle(info));
  443. }
  444.  
  445. static obj_t fop_nil(struct load_info *info)
  446. {
  447.     return obj_Nil;
  448. }
  449.  
  450. static obj_t read_list(struct load_info *info, int len, boolean dotted)
  451. {
  452.     obj_t result, *prev;
  453.  
  454.     prev = &result;
  455.  
  456.     while (len-- > 0) {
  457.     obj_t new = pair(read_thing(info), obj_False);
  458.     *prev = new;
  459.     prev = &TAIL(new);
  460.     }
  461.  
  462.     if (dotted)
  463.     *prev = read_thing(info);
  464.     else
  465.     *prev = obj_Nil;
  466.  
  467.     return result;
  468. }
  469.  
  470. static obj_t fop_list1(struct load_info *info)
  471. {
  472.     return pair(read_thing(info), obj_Nil);
  473. }
  474.  
  475. static obj_t fop_list2(struct load_info *info)
  476. {
  477.     return read_list(info, 2, FALSE);
  478. }
  479.  
  480. static obj_t fop_list3(struct load_info *info)
  481. {
  482.     return read_list(info, 3, FALSE);
  483. }
  484.  
  485. static obj_t fop_list4(struct load_info *info)
  486. {
  487.     return read_list(info, 4, FALSE);
  488. }
  489.  
  490. static obj_t fop_list5(struct load_info *info)
  491. {
  492.     return read_list(info, 5, FALSE);
  493. }
  494.  
  495. static obj_t fop_list6(struct load_info *info)
  496. {
  497.     return read_list(info, 6, FALSE);
  498. }
  499.  
  500. static obj_t fop_list7(struct load_info *info)
  501. {
  502.     return read_list(info, 7, FALSE);
  503. }
  504.  
  505. static obj_t fop_list8(struct load_info *info)
  506. {
  507.     return read_list(info, 8, FALSE);
  508. }
  509.  
  510. static obj_t fop_listn(struct load_info *info)
  511. {
  512.     return read_list(info, read_byte(info)+9, FALSE);
  513. }
  514.  
  515. static obj_t fop_dotted_list1(struct load_info *info)
  516. {
  517.     return read_list(info, 1, TRUE);
  518. }
  519.  
  520. static obj_t fop_dotted_list2(struct load_info *info)
  521. {
  522.     return read_list(info, 2, TRUE);
  523. }
  524.  
  525. static obj_t fop_dotted_list3(struct load_info *info)
  526. {
  527.     return read_list(info, 3, TRUE);
  528. }
  529.  
  530. static obj_t fop_dotted_list4(struct load_info *info)
  531. {
  532.     return read_list(info, 4, TRUE);
  533. }
  534.  
  535. static obj_t fop_dotted_list5(struct load_info *info)
  536. {
  537.     return read_list(info, 5, TRUE);
  538. }
  539.  
  540. static obj_t fop_dotted_list6(struct load_info *info)
  541. {
  542.     return read_list(info, 6, TRUE);
  543. }
  544.  
  545. static obj_t fop_dotted_list7(struct load_info *info)
  546. {
  547.     return read_list(info, 7, TRUE);
  548. }
  549.  
  550. static obj_t fop_dotted_list8(struct load_info *info)
  551. {
  552.     return read_list(info, 8, TRUE);
  553. }
  554.  
  555. static obj_t fop_dotted_listn(struct load_info *info)
  556. {
  557.     return read_list(info, read_byte(info)+9, TRUE);
  558. }
  559.  
  560. static obj_t read_vector(struct load_info *info, int len)
  561. {
  562.     obj_t res = make_vector(len, NULL);
  563.     int i;
  564.  
  565.     for (i = 0; i < len; i++)
  566.     SOVEC(res)->contents[i] = read_thing(info);
  567.  
  568.     return res;
  569. }
  570.  
  571. static obj_t fop_vector0(struct load_info *info)
  572. {
  573.     return read_vector(info, 0);
  574. }
  575.  
  576. static obj_t fop_vector1(struct load_info *info)
  577. {
  578.     return read_vector(info, 1);
  579. }
  580.  
  581. static obj_t fop_vector2(struct load_info *info)
  582. {
  583.     return read_vector(info, 2);
  584. }
  585.  
  586. static obj_t fop_vector3(struct load_info *info)
  587. {
  588.     return read_vector(info, 3);
  589. }
  590.  
  591. static obj_t fop_vector4(struct load_info *info)
  592. {
  593.     return read_vector(info, 4);
  594. }
  595.  
  596. static obj_t fop_vector5(struct load_info *info)
  597. {
  598.     return read_vector(info, 5);
  599. }
  600.  
  601. static obj_t fop_vector6(struct load_info *info)
  602. {
  603.     return read_vector(info, 6);
  604. }
  605.  
  606. static obj_t fop_vector7(struct load_info *info)
  607. {
  608.     return read_vector(info, 7);
  609. }
  610.  
  611. static obj_t fop_vector8(struct load_info *info)
  612. {
  613.     return read_vector(info, 8);
  614. }
  615.  
  616. static obj_t fop_vectorn(struct load_info *info)
  617. {
  618.     int len = read_byte(info);
  619.  
  620.     if (len == 255)
  621.     len = read_int(info)+9+254+(1<<16);
  622.     else if (len == 254)
  623.     len = read_ushort(info)+9+254;
  624.     else
  625.     len += 9;
  626.  
  627.     return read_vector(info, len);
  628. }
  629.  
  630. static obj_t fop_value_cell(struct load_info *info)
  631. {
  632.     return rawptr_obj(find_variable(info->module, read_thing(info), FALSE, TRUE));
  633. }
  634.  
  635. static obj_t fop_writable_value_cell(struct load_info *info)
  636. {
  637.     return rawptr_obj(find_variable(info->module, read_thing(info), TRUE, TRUE));
  638. }
  639.  
  640. static obj_t fop_builtin_value_cell(struct load_info *info)
  641. {
  642.     return rawptr_obj(find_variable(module_BuiltinStuff, read_thing(info),
  643.                     FALSE, TRUE));
  644. }
  645.  
  646. static obj_t fop_builtin_writable_value_cell(struct load_info *info)
  647. {
  648.     return rawptr_obj(find_variable(module_BuiltinStuff, read_thing(info),
  649.                     TRUE, TRUE));
  650. }
  651.  
  652. static obj_t fop_note_reference(struct load_info *info)
  653. {
  654.     int line = read_int(info);
  655.     obj_t var_obj = read_thing(info);
  656.     struct variable *var = obj_rawptr(var_obj);
  657.  
  658.     if (var->ref_file == obj_False) {
  659.     var->ref_file = info->source_file;
  660.     var->ref_line = line;
  661.     }
  662.  
  663.     return var_obj;
  664. }
  665.  
  666. static obj_t read_component(struct load_info *info, int nconst, int nbytes)
  667. {
  668.     obj_t debug_name = read_thing(info);
  669.     int frame_size = fixnum_value(read_thing(info));
  670.     obj_t debug_info = read_thing(info);
  671.     obj_t res = make_component(debug_name, frame_size, info->mtime,
  672.                    info->source_file, debug_info, nconst, nbytes);
  673.     int i;
  674.  
  675.     for (i = 0; i < nconst; i++)
  676.     obj_ptr(struct component *, res)->constant[i] = read_thing(info);
  677.     read_bytes(info, &obj_ptr(struct component *, res)->constant[nconst],
  678.            nbytes);
  679.  
  680.     return res;
  681. }
  682.  
  683. static obj_t fop_short_component(struct load_info *info)
  684. {
  685.     int nconst = read_byte(info);
  686.     int nbytes = read_ushort(info);
  687.  
  688.     return read_component(info, nconst, nbytes);
  689. }
  690.  
  691. static obj_t fop_component(struct load_info *info)
  692. {
  693.     int nconst = read_int(info);
  694.     int nbytes = read_int(info);
  695.  
  696.     return read_component(info, nconst, nbytes);
  697. }
  698.  
  699. static obj_t read_method(struct load_info *info, int param_info,
  700.              int nclosure_vars)
  701. {
  702.     boolean restp = param_info & 1;
  703.     boolean all_keys = param_info & 2;
  704.     int nkeys = (param_info>>2)-1;
  705.     obj_t keys;
  706.  
  707.     if (nkeys == -1)
  708.     keys = obj_False;
  709.     else {
  710.     obj_t *prev = &keys;
  711.     while (nkeys-- > 0) {
  712.         obj_t key = read_thing(info);
  713.         obj_t def = read_thing(info);
  714.         obj_t keyinfo = pair(key, def);
  715.         obj_t new = list1(keyinfo);
  716.         *prev = new;
  717.         prev = &TAIL(new);
  718.     }
  719.     *prev = obj_Nil;
  720.     }
  721.  
  722.     return make_method_info(restp, keys, all_keys, read_thing(info),
  723.                 nclosure_vars);
  724. }
  725.  
  726. static obj_t fop_short_method(struct load_info *info)
  727. {
  728.     int param_info = read_byte(info);
  729.     int nclosure_vars = read_byte(info);
  730.  
  731.     return read_method(info, param_info, nclosure_vars);
  732. }
  733.  
  734. static obj_t fop_method(struct load_info *info)
  735. {
  736.     int param_info = read_int(info);
  737.     int nclosure_vars = read_int(info);
  738.  
  739.     return read_method(info, param_info, nclosure_vars);
  740. }
  741.  
  742. static obj_t fop_in_library(struct load_info *info)
  743. {
  744.     obj_t name = read_thing(info);
  745.     info->library = find_library(name, TRUE);
  746.     if (CurLibrary == NULL)
  747.     CurLibrary = info->library;
  748.     return name;
  749. }
  750.  
  751. static obj_t fop_in_module(struct load_info *info)
  752. {
  753.     obj_t name = read_thing(info);
  754.     info->module = find_module(info->library, name, TRUE, TRUE);
  755.     if (CurLibrary == info->library && CurModule == NULL)
  756.     CurModule = info->module;
  757.     return name;
  758. }
  759.  
  760. static obj_t fop_source_file(struct load_info *info)
  761. {
  762.     info->mtime = read_thing(info);
  763.     info->source_file = read_thing(info);
  764.     return info->source_file;
  765. }
  766.  
  767. static obj_t make_top_level_method(obj_t component)
  768. {
  769.     obj_t method_info = make_method_info(FALSE, obj_False, FALSE,
  770.                      component, 0);
  771.     return make_byte_method(method_info, obj_Nil, obj_Nil, obj_ObjectClass,
  772.                 NULL);
  773. }
  774.  
  775. static obj_t queue_form(struct queue *queue, obj_t component)
  776. {
  777.     struct form *new = malloc(sizeof(*new));
  778.  
  779.     new->method = make_top_level_method(component);
  780.     new->next = NULL;
  781.  
  782.     *queue->tail = new;
  783.     queue->tail = &new->next;
  784.  
  785.     return function_debug_name_or_self(new->method);
  786. }
  787.  
  788. static obj_t fop_top_level_form(struct load_info *info)
  789. {
  790.     return queue_form(&State.top_level_forms, read_thing(info));
  791. }
  792.  
  793. static obj_t fop_define_class(struct load_info *info)
  794. {
  795.     obj_t name = read_thing(info);
  796.     struct variable *var;
  797.     obj_t slot;
  798.  
  799.     define_variable(info->module, name, var_Class);
  800.     var = find_variable(info->module, name, FALSE, TRUE);
  801.  
  802.     if (var->value != obj_Unbound)
  803.     error("Can't both define class and define method %s", name);
  804.  
  805.     var->value = make_defined_class(name, info->library);
  806.  
  807.     while ((slot = read_thing(info)) != obj_False)
  808.     define_variable(info->module, slot, var_Method);
  809.  
  810.     queue_form(&State.classes, read_thing(info));
  811.     queue_form(&State.top_level_forms, read_thing(info));
  812.  
  813.     return name;
  814. }
  815.  
  816. static obj_t fop_define_generic(struct load_info *info)
  817. {
  818.     obj_t name = read_thing(info);
  819.     obj_t tlf = read_thing(info);
  820.  
  821.     define_variable(info->module, name, var_GenericFunction);
  822.     queue_form(&State.top_level_forms, tlf);
  823.  
  824.     return name;
  825. }
  826.  
  827. static obj_t fop_define_method(struct load_info *info)
  828. {
  829.     obj_t name = read_thing(info);
  830.     obj_t tlf = read_thing(info);
  831.  
  832.     define_variable(info->module, name, var_Method);
  833.     queue_form(&State.top_level_forms, tlf);
  834.  
  835.     return name;
  836. }
  837.  
  838. static obj_t fop_define_constant(struct load_info *info)
  839. {
  840.     int num_names = fixnum_value(read_thing(info));
  841.     int i;
  842.  
  843.     for (i = 0; i < num_names; i++)
  844.     define_variable(info->module, read_thing(info), var_Constant);
  845.     return queue_form(&State.top_level_forms, read_thing(info));
  846. }
  847.  
  848. static obj_t fop_define_variable(struct load_info *info)
  849. {
  850.     int num_names = fixnum_value(read_thing(info));
  851.     int i;
  852.  
  853.     for (i = 0; i < num_names; i++)
  854.     define_variable(info->module, read_thing(info), var_Variable);
  855.     return queue_form(&State.top_level_forms, read_thing(info));
  856. }
  857.  
  858. static struct defn *read_defn(struct load_info *info, boolean read_creates)
  859. {
  860.     struct defn *defn = malloc(sizeof(struct defn));
  861.     struct use *use, **prev;
  862.     obj_t name;
  863.  
  864.     defn->name = read_thing(info);
  865.     prev = &defn->use;
  866.     while ((name = read_thing(info)) != obj_False) {
  867.     use = malloc(sizeof(struct use));
  868.     use->name = name;
  869.     use->import = read_thing(info);
  870.     use->exclude = read_thing(info);
  871.     use->prefix = read_thing(info);
  872.     use->rename = read_thing(info);
  873.     use->export = read_thing(info);
  874.     *prev = use;
  875.     prev = &use->next;
  876.     }
  877.     *prev = NULL;
  878.     defn->exports = read_thing(info);
  879.     if (read_creates)
  880.     defn->creates = read_thing(info);
  881.     else
  882.     defn->creates = obj_Nil;
  883.  
  884.     return defn;
  885. }
  886.  
  887. static obj_t fop_define_library(struct load_info *info)
  888. {
  889.     struct defn *defn = read_defn(info, FALSE);
  890.  
  891.     define_library(defn);
  892.  
  893.     return defn->name;
  894. }
  895.  
  896. static obj_t fop_define_module(struct load_info *info)
  897. {
  898.     struct defn *defn = read_defn(info, TRUE);
  899.  
  900.     define_module(info->library, defn);
  901.  
  902.     return defn->name;
  903. }
  904.  
  905. static obj_t fop_done(struct load_info *info)
  906. {
  907.     info->done = TRUE;
  908.     return obj_False;
  909. }
  910.  
  911.  
  912. /* Interface routines. */
  913.  
  914. static void skip_header(struct load_info *info)
  915. {
  916.     int c;
  917.  
  918.     while ((c = read_byte(info)) == '#')
  919.     while ((c = read_byte(info)) != '\n')
  920.         ;
  921.  
  922.     if (c != fop_HEADER)
  923.     error("Invalid .dbc file: %s", make_byte_string(info->name));
  924.  
  925.     unread_byte(info);
  926. }
  927.  
  928. static void load_group(struct load_info *info)
  929. {
  930.     info->done = FALSE;
  931.     info->next_handle = 0;
  932.  
  933.     skip_header(info);
  934.  
  935.     while (!info->done)
  936.     read_thing(info);
  937. }
  938.  
  939. struct load_info *make_load_info(char *name, int fd)
  940. {
  941.     struct load_info *info
  942.     = (struct load_info *)malloc(sizeof(struct load_info));
  943.  
  944.     info->name = name;
  945.     info->fd = fd;
  946.     info->buffer = (unsigned char *)malloc(BUFFER_SIZE);
  947.     info->ptr = info->end = info->buffer;
  948.     info->table = info->table_end = 0;
  949.     info->swap_bytes = FALSE;
  950.     info->done = FALSE;
  951.     info->library = NULL;
  952.     info->module = NULL;
  953.     info->mtime = make_fixnum(0);
  954.     info->source_file = obj_False;
  955.  
  956.     return info;
  957. }
  958.  
  959. static void free_load_info(struct load_info *info)
  960. {
  961.     if (info->table)
  962.     free(info->table);
  963.     free(info->buffer);
  964.     free(info);
  965. }
  966.  
  967. void load(char *name)
  968. {
  969.     int fd;
  970.     struct load_info *info;
  971.  
  972.     if (strcmp(name, "-") == 0)
  973.       fd = 0;
  974.     else
  975.       fd = open(name, O_RDONLY, 0);
  976.     if (fd < 0)
  977.     error("Error loading %s: %s\n",
  978.           make_byte_string(name),
  979.           make_byte_string(strerror(errno)));
  980.  
  981.     info = make_load_info(name, fd);
  982.  
  983.     while (1) {
  984.     load_group(info);
  985.     if (info->ptr == info->end) {
  986.         int count = read(fd, info->buffer, BUFFER_SIZE);
  987.         if (count < 0)
  988.         error("error loading %s: %s",
  989.               make_byte_string(name),
  990.               make_byte_string(strerror(errno)));
  991.         if (count == 0)
  992.         break;
  993.         info->ptr = info->buffer;
  994.         info->end = info->ptr + count;
  995.     }
  996.     }
  997.     if (info->fd != 0)
  998.       close(info->fd);
  999.     free_load_info(info);
  1000. }
  1001.  
  1002.  
  1003. /* Library loading. */
  1004.  
  1005. void load_library(obj_t name)
  1006. {
  1007.     char *load_path = getenv("MINDYPATH");
  1008.     char path[MAXPATHLEN];
  1009.     char *start, *ptr, *src, *dst;
  1010.     int c;
  1011.  
  1012.     if (load_path == NULL)
  1013.     load_path = DEFAULT_LOAD_PATH;
  1014.  
  1015.     start = load_path;
  1016.     ptr = load_path;
  1017.     do {
  1018.     c = *ptr;
  1019.     if (c == ':' || c == '\0') {
  1020.         int len = ptr - start;
  1021.         if (len) {
  1022.         memcpy(path, start, len);
  1023.         path[len++] = '/';
  1024.         }
  1025.         dst = path+len;
  1026.         for (src = sym_name(name); *src != '\0'; src++)
  1027.         if (isupper(*src))
  1028.             *dst++ = tolower(*src);
  1029.         else
  1030.             *dst++ = *src;
  1031.         strcpy(dst, "-lib.dbc");
  1032.         if (access(path, R_OK) == 0) {
  1033.         load(path);
  1034.         return;
  1035.         }
  1036.         strcpy(dst, ".dbc");
  1037.         if (access(path, R_OK) == 0) {
  1038.         load(path);
  1039.         return;
  1040.         }
  1041.         start = ptr+1;
  1042.     }
  1043.     ptr++;
  1044.     } while (c != '\0');
  1045.  
  1046.     error("Can't find library %s", name);
  1047. }
  1048.  
  1049.  
  1050. /* Stuff to run the inits. */
  1051.  
  1052. static void do_next_init(struct thread *thread);
  1053.  
  1054. static void did_form(struct thread *thread, obj_t *vals)
  1055. {
  1056.     thread->sp = vals;
  1057.     do_next_init(thread);
  1058. }
  1059.  
  1060. static void do_next_init(struct thread *thread)
  1061. {
  1062.     if (State.everything.head) {
  1063.     struct form *tlf = State.everything.head;
  1064.     State.everything.head = tlf->next;
  1065.  
  1066.     *thread->sp++ = tlf->method;
  1067.  
  1068.     free(tlf);
  1069.  
  1070.     set_c_continuation(thread, did_form);
  1071.     invoke(thread, 0);
  1072.     }
  1073.     else
  1074.     do_return(thread, pop_linkage(thread), thread->sp);
  1075. }
  1076.  
  1077. static void do_first_init(struct thread *thread, int nargs)
  1078. {
  1079.     *State.classes.tail = State.top_level_forms.head;
  1080.     State.top_level_forms.head = NULL;
  1081.     State.top_level_forms.tail = NULL;
  1082.  
  1083.     *State.everything.tail = State.classes.head;
  1084.     State.classes.head = NULL;
  1085.     State.classes.tail = NULL;
  1086.  
  1087.     assert(nargs == 0);
  1088.     push_linkage(thread, thread->sp);
  1089.     do_next_init(thread);
  1090. }
  1091.  
  1092. void load_do_inits(struct thread *thread)
  1093. {
  1094.     *thread->sp++ = make_raw_function("init", 0, FALSE, obj_False, FALSE,
  1095.                       obj_Nil, obj_ObjectClass,
  1096.                       do_first_init);
  1097.     invoke(thread, 0);
  1098. }
  1099.  
  1100.  
  1101. /* GC hooks */
  1102.  
  1103. void scavenge_load_roots(void)
  1104. {
  1105.     struct form *tlf;
  1106.  
  1107.     for (tlf = State.everything.head; tlf != NULL; tlf = tlf->next)
  1108.     scavenge(&tlf->method);
  1109.     for (tlf = State.classes.head; tlf != NULL; tlf = tlf->next)
  1110.     scavenge(&tlf->method);
  1111.     for (tlf = State.top_level_forms.head; tlf != NULL; tlf = tlf->next)
  1112.     scavenge(&tlf->method);
  1113. }
  1114.  
  1115.  
  1116. /* Init stuff. */
  1117.  
  1118. void init_loader(void)
  1119. {
  1120.     int i;
  1121.  
  1122.     for (i = 0; i < 256; i++)
  1123.     opcodes[i] = fop_flame;
  1124.  
  1125.     opcodes[fop_HEADER] = fop_header;
  1126.     opcodes[fop_STORE] = fop_store;
  1127.     opcodes[fop_SHORT_REF] = fop_short_ref;
  1128.     opcodes[fop_REF] = fop_ref;
  1129.     opcodes[fop_FALSE] = fop_false;
  1130.     opcodes[fop_TRUE] = fop_true;
  1131.     opcodes[fop_UNBOUND] = fop_unbound;
  1132.     opcodes[fop_SIGNED_BYTE] = fop_signed_byte;
  1133.     opcodes[fop_SIGNED_SHORT] = fop_signed_short;
  1134.     opcodes[fop_SIGNED_INT] = fop_signed_int;
  1135.     opcodes[fop_SIGNED_LONG] = fop_signed_long;
  1136.     opcodes[fop_CHAR] = fop_char;
  1137.     opcodes[fop_SINGLE_FLOAT] = fop_single_float;
  1138.     opcodes[fop_DOUBLE_FLOAT] = fop_double_float;
  1139.     opcodes[fop_EXTENDED_FLOAT] = fop_extended_float;
  1140.     opcodes[fop_SHORT_STRING] = fop_short_string;
  1141.     opcodes[fop_STRING] = fop_string;
  1142.     opcodes[fop_SHORT_SYMBOL] = fop_short_symbol;
  1143.     opcodes[fop_SYMBOL] = fop_symbol;
  1144.     opcodes[fop_NIL] = fop_nil;
  1145.     opcodes[fop_LIST1] = fop_list1;
  1146.     opcodes[fop_LIST2] = fop_list2;
  1147.     opcodes[fop_LIST3] = fop_list3;
  1148.     opcodes[fop_LIST4] = fop_list4;
  1149.     opcodes[fop_LIST5] = fop_list5;
  1150.     opcodes[fop_LIST6] = fop_list6;
  1151.     opcodes[fop_LIST7] = fop_list7;
  1152.     opcodes[fop_LIST8] = fop_list8;
  1153.     opcodes[fop_LISTN] = fop_listn;
  1154.     opcodes[fop_DOTTED_LIST1] = fop_dotted_list1;
  1155.     opcodes[fop_DOTTED_LIST2] = fop_dotted_list2;
  1156.     opcodes[fop_DOTTED_LIST3] = fop_dotted_list3;
  1157.     opcodes[fop_DOTTED_LIST4] = fop_dotted_list4;
  1158.     opcodes[fop_DOTTED_LIST5] = fop_dotted_list5;
  1159.     opcodes[fop_DOTTED_LIST6] = fop_dotted_list6;
  1160.     opcodes[fop_DOTTED_LIST7] = fop_dotted_list7;
  1161.     opcodes[fop_DOTTED_LIST8] = fop_dotted_list8;
  1162.     opcodes[fop_DOTTED_LISTN] = fop_dotted_listn;
  1163.     opcodes[fop_VECTOR0] = fop_vector0;
  1164.     opcodes[fop_VECTOR1] = fop_vector1;
  1165.     opcodes[fop_VECTOR2] = fop_vector2;
  1166.     opcodes[fop_VECTOR3] = fop_vector3;
  1167.     opcodes[fop_VECTOR4] = fop_vector4;
  1168.     opcodes[fop_VECTOR5] = fop_vector5;
  1169.     opcodes[fop_VECTOR6] = fop_vector6;
  1170.     opcodes[fop_VECTOR7] = fop_vector7;
  1171.     opcodes[fop_VECTOR8] = fop_vector8;
  1172.     opcodes[fop_VECTORN] = fop_vectorn;
  1173.     opcodes[fop_VALUE_CELL] = fop_value_cell;
  1174.     opcodes[fop_WRITABLE_VALUE_CELL] = fop_writable_value_cell;
  1175.     opcodes[fop_BUILTIN_VALUE_CELL] = fop_builtin_value_cell;
  1176.     opcodes[fop_BUILTIN_WRITABLE_VALUE_CELL] = fop_builtin_writable_value_cell;
  1177.     opcodes[fop_NOTE_REFERENCE] = fop_note_reference;
  1178.     opcodes[fop_SHORT_COMPONENT] = fop_short_component;
  1179.     opcodes[fop_COMPONENT] = fop_component;
  1180.     opcodes[fop_METHOD] = fop_method;
  1181.     opcodes[fop_SHORT_METHOD] = fop_short_method;
  1182.     opcodes[fop_IN_LIBRARY] = fop_in_library;
  1183.     opcodes[fop_IN_MODULE] = fop_in_module;
  1184.     opcodes[fop_SOURCE_FILE] = fop_source_file;
  1185.     opcodes[fop_TOP_LEVEL_FORM] = fop_top_level_form;
  1186.     opcodes[fop_DEFINE_CONSTANT] = fop_define_constant;
  1187.     opcodes[fop_DEFINE_VARIABLE] = fop_define_variable;
  1188.     opcodes[fop_DEFINE_GENERIC] = fop_define_generic;
  1189.     opcodes[fop_DEFINE_METHOD] = fop_define_method;
  1190.     opcodes[fop_DEFINE_CLASS] = fop_define_class;
  1191.     opcodes[fop_DEFINE_LIBRARY] = fop_define_library;
  1192.     opcodes[fop_DEFINE_MODULE] = fop_define_module;
  1193.     opcodes[fop_DONE] = fop_done;
  1194.  
  1195.     State.everything.head = NULL;
  1196.     State.everything.tail = &State.everything.head;
  1197.     State.classes.head = NULL;
  1198.     State.classes.tail = &State.classes.head;
  1199.     State.top_level_forms.head = NULL;
  1200.     State.top_level_forms.tail = &State.top_level_forms.head;
  1201. }
  1202.